﻿<%
'编码处理运算类
Class CharClass

	Private s_init, s_lPower2(31), s_stm

	'''构造
	Private Sub Class_Initialize()
		Set s_stm = Server.CreateObject("Adodb.Stream")
		s_init = False
		'init_()
	End Sub

	'''析构
	Private Sub Class_Terminate()
		Set s_stm = Nothing
	End Sub

	'''初始化
	Private Sub init_()
		On Error Resume Next
		s_lPower2(0) = &H1&
		s_lPower2(1) = &H2&
		s_lPower2(2) = &H4&
		s_lPower2(3) = &H8&
		s_lPower2(4) = &H10&
		s_lPower2(5) = &H20&
		s_lPower2(6) = &H40&
		s_lPower2(7) = &H80&
		s_lPower2(8) = &H100&
		s_lPower2(9) = &H200&
		s_lPower2(10) = &H400&
		s_lPower2(11) = &H800&
		s_lPower2(12) = &H1000&
		s_lPower2(13) = &H2000&
		s_lPower2(14) = &H4000&
		s_lPower2(15) = &H8000&
		s_lPower2(16) = &H10000
		s_lPower2(17) = &H20000
		s_lPower2(18) = &H40000
		s_lPower2(19) = &H80000
		s_lPower2(20) = &H100000
		s_lPower2(21) = &H200000
		s_lPower2(22) = &H400000
		s_lPower2(23) = &H800000
		s_lPower2(24) = &H1000000
		s_lPower2(25) = &H2000000
		s_lPower2(26) = &H4000000
		s_lPower2(27) = &H8000000
		s_lPower2(28) = &H10000000
		s_lPower2(29) = &H20000000
		s_lPower2(30) = &H40000000
		s_lPower2(31) = &H80000000
		s_init = True
		On Error Goto 0
	End Sub

	'去除字符串首尾空格及指定字符
	'p_s: String (字符串) 要检查的字符串
	'p_c : String/Array, 除了删除了首尾空格之后还要删除这些首尾字符串。
	Public Function SuperTrim(Byval p_s, Byval p_c)
		On Error Resume Next
		If p_s <> "" Then
			Dim t_t, t_e, t_c, t_i : t_i = 0
			t_t = RegReplace(p_s, "(^\s*)|(\s*$)", "")
			If IsArray(p_c) Then
				For Each t_e In p_c
					If Not (IsArray(t_e) Or IsObject(t_e)) Then
						If t_i = 0 Then
							t_c = "(^"&t_e&"*)|("&t_e&"*$)"
						Else
							t_c = t_c & "|(^"&t_e&"*)|("&t_e&"*$)"
						End If
					End If
					t_i = t_i + 1
				Next
				If t_c <> "" Then t_t = RegReplace(t_t, t_c, "")
			ElseIf Trim(p_c&"") <> "" Then
				t_t = RegReplace(t_t, "(^"&p_c&"*)|("&p_c&"*$)", "")
			End If
			SuperTrim = t_t
		End If
		On Error Goto 0
	End Function

	'''SuperTrim的别名
	Public Function ST(Byval p_s, Byval p_c)
		ST = SuperTrim(p_s, p_c)
	End Function
	
	
	'去除字符串首空格及指定字符
	'p_s: String (字符串) 要检查的字符串
	'p_c : String/Array, 除了删除了首空格之后还要删除这些首字符串。
	Public Function SuperLTrim(Byval p_s, Byval p_c)
		On Error Resume Next
		If p_s <> "" Then
			Dim t_t, t_e, t_c, t_i : t_i = 0
			t_t = RegReplace(p_s, "(^\s*)", "")
			If IsArray(p_c) Then
				For Each t_e In p_c
					If Not (IsArray(t_e) Or IsObject(t_e)) Then
						If t_i = 0 Then
							t_c = "(^"&t_e&"*)"
						Else
							t_c = t_c & "|(^"&t_e&"*)"
						End If
					End If
					t_i = t_i + 1
				Next
				If t_c <> "" Then t_t = RegReplace(t_t, t_c, "")
			ElseIf LTrim(p_c&"") <> "" Then
				t_t = RegReplace(t_t, "(^"&p_c&"*)", "")
			End If
			SuperLTrim = t_t
		End If
		On Error Goto 0
	End Function

	'''SuperLTrim的别名
	Public Function SLT(Byval p_s, Byval p_c)
		SLT = SuperLTrim(p_s, p_c)
	End Function
	
	'去除字符串尾空格及指定字符
	'p_s: String (字符串) 要检查的字符串
	'p_c : String/Array, 除了删除了尾空格之后还要删除这些尾字符串。
	Public Function SuperRTrim(Byval p_s, Byval p_c)
		On Error Resume Next
		If p_s <> "" Then
			Dim t_t, t_e, t_c, t_i : t_i = 0
			t_t = RegReplace(p_s, "(\s*$)", "")
			If IsArray(p_c) Then
				For Each t_e In p_c
					If Not (IsArray(t_e) Or IsObject(t_e)) Then
						If t_i = 0 Then
							t_c = "("&t_e&"*$)"
						Else
							t_c = t_c & "|("&t_e&"*$)"
						End If
					End If
					t_i = t_i + 1
				Next
				If t_c <> "" Then t_t = RegReplace(t_t, t_c, "")
			ElseIf RTrim(p_c&"") <> "" Then
				t_t = RegReplace(t_t, "("&p_c&"*$)", "")
			End If
			SuperRTrim = t_t
		End If
		On Error Goto 0
	End Function

	'''SuperRTrim的别名
	Public Function SRT(Byval p_s, Byval p_c)
		SRT = SuperRTrim(p_s, p_c)
	End Function

	'''计算字符串宽度(汉字则宽度为2, 英文字母及数字为1)
	'p_s:字符串
	'p_g:指定算法
	Public Function StrLen(Byval p_s, Byval p_g)
		If p_g = "" Then
			p_g = 1
		End If
		Dim t_i, t_k, t_x, t_c
		If p_g=1 Then
			If IsNull(p_s) Or p_s="" Then
				StrLen = 0
			Else
				t_k = 0
				For t_i = 1 To Len(p_s)
					t_c = Mid(p_s, t_i, 1)
					If Asc(t_c)>=0 and Asc(t_c)<=255 Then
						t_k = t_k + 1
					Else
						t_k = t_k + 2
					End If
				Next
				StrLen = t_k
			End If
		ElseIf p_g=2 Then
			t_i = 0
			If p_s<>"" Then
				For t_x=1 To Len(p_s)
					t_i = t_i + Len(Hex(Asc(Mid(p_s, t_x, 1))))/2
				Next
			End If
			StrLen = t_i
		ElseIf p_g=3 Then
			If isNull(p_s) Or p_s="" Then
				StrLen=0 : Exit Function
			End If
			Dim t_osc : t_osc = (Len("例子")=2)
			If t_osc Then
				t_k = Len(p_s)
				For t_i=1 To Len(p_s)
					t_c = Asc(Mid(p_s,t_i,1))
					If t_c<0 Then
						t_c = t_c + 65536
					End If
					If t_c>255 Then
						t_k = t_k + 1
					End If
				Next
				StrLen = t_k
			Else
				StrLen = Len(p_s)
			End If
		Else
			t_k = 0
			Dim t_r : Set t_r = New RegExp
			t_r.Global = True
			t_r.IgnoreCase = True
			t_r.Pattern = "[\u4E00-\u9FA5\uF900-\uFA2D]"
			For Each t_i In t_r.Execute(p_s)
				t_k = t_k + 1
			Next
			Set t_r=Nothing
			t_k = t_k + Len(p_s)
			StrLen = t_k
		End If
	End Function

	'''StrLen的别名
	Public Function SL(Byval p_s)
		SL = StrLen(p_s, 1)
	End Function

	'''按字符宽度截取字符串
	'p_s:原字符串
	'p_n:截取的字符宽度(后缀修饰符算在内)
	'p_p:后缀修饰符
	Public Function StrSub(Byval p_s, Byval p_n, Byval p_p)
		If p_p = "" Then
			StrSub = CutStr(p_s, p_n)
		Else
			StrSub = CutStr(p_s, Cstr(p_n & ":" & p_p))
		End If
	End Function

	'''StrSub的别名
	Public Function SS(Byval p_s, Byval p_n, Byval p_p)
		SS = StrSub(p_s, p_n, p_p)
	End Function

	'''过滤字符串中的HTML标签
	'p_s:字符串(加码转换后的字符串)
	Public Function EraseHtml(Byval p_s)
		EraseHtml = HtmlFilter(p_s)
	End Function

	''突出显示字符串中查询到的单词的函数
	'p_s:String (字符串) 原字符串
	'p_w:String (字符串) 关键词
	Public Function BoldWord(Byval p_s, Byval p_w)
		BoldWord = RegReplace(p_s, "("&p_w&")", "<font color='#FF0000'>$1</font>")
	End Function

	'''BoldWord的别名
	Public Function BW(Byval p_s, Byval p_w)
		BW = BoldWord(p_s, p_w)
	End Function

	'''将汉字等转换为&#开头的unicode字符串形式
	'p_s:String (字符串) 原字符串
	Public Function ToUnicode(Byval p_s)
		Dim t_i,t_j,t_c,t_p
		ToUnicode=""
		t_p=""
		For t_i=1 To Len(p_s)
			t_c = Mid(p_s,t_i,1)
			t_j = Ascw(t_c)
			If t_j<0 Then
				t_j = t_j + 65536
			End If
			If t_j>=0 And t_j<=128 Then
				If t_p="c" Then
					ToUnicode = " " & ToUnicode
					t_p = "e"
				End If
				ToUnicode = ToUnicode & t_c
			Else
				If t_p="e" Then
					ToUnicode = ToUnicode & " "
					t_p = "c"
				End If
				ToUnicode = ToUnicode & "&#" & t_j & ";"
			End If
		Next
	End Function

	'''ToUnicode的别名
	Public Function TU(Byval p_s)
		TU = ToUnicode(p_s)
	End Function
	
	'''GB2312转换为UTF-8
	'p_s:String (字符串) 原字符串
	Public Function GB2UTF(Byval p_s)
		Dim t_s:t_s = p_s
		Dim t_t:t_t=""
		Dim t_i,t_o
		For t_i=1 to Len(t_s)
			t_o = Mid(t_s,t_i,1)
			t_t = t_t & chr(38)
			t_t = t_t & chr(35)
			t_t = t_t & chr(120)
			t_t = t_t & Hex(Ascw(t_o))
			t_t = t_t & chrW(59)
		Next
		GB2UTF = t_t
	End Function

	'''GB2UTF的别名
	Public Function GTU(Byval p_s)
		GTU = GB2UTF(p_s)
	End Function

	'''10进制转为16进制
	'p_s: String (字符串) 原字符串
	Private Function b2H_(Byval p_s)
		Dim t_i,t_j
		t_j = 0
		For t_i = 1 To Len(p_s)
			t_j = t_j + CLng(Mid(p_s, t_i, 1)) * 2 ^ (Len(p_s) - t_i)
		Next
		b2H_ = CStr(Hex(t_j))
	End Function
	
	'''2进制转为16进制
	'p_s: String (字符串) 原字符串
	Public Function Bin2Hex(Byval p_s)
		Dim t_i, t_l, t_k, t_n, t_o, t_t
		p_s = Trim(p_s)
		t_t = ""
		t_l = Len(p_s)
		t_k = CInt((t_l + 3) / 4)
		t_n = CInt(t_l Mod 4)
		For t_i = 0 To t_k - 1
			If t_i = 0 Then
				t_o = Mid(p_s, 1, t_n)
			Else
				t_o = Mid(p_s, t_n + 4 * t_i - 3, 4)
			End If
			If t_o <> "" Then t_t = t_t & b2H_(t_o)
		Next
		Bin2Hex = t_t
	End Function
	
	'''Bin2Hex的别名
	Public Function BTH(Byval p_s)
		BTH = Bin2Hex(p_s)
	End Function
	
	'''2进制转为16进制(Bin2Hex的别名)
	'p_s: String (字符串) 原字符串
	Public Function C2To16(Byval p_s)
		C2To16 = Bin2Hex(p_s)
	End Function
	
	'''2进制转为10进制
	'p_s: String (字符串) 原字符串
	Public Function C2To10(Byval p_s)
		Dim t_s : t_s=0
		If p_s="0" Then
			Exit Function
		End If
		Dim t_i : t_i=0
		For t_i= 0 To Len(p_s) -1
			If Mid(p_s,Len(p_s)-i,1)="1" Then
				t_s = t_s + 2^(t_i)
			End If
		Next
		C2To10 = t_s
	End Function

	'''10进制转为2进制
	'p_s: String (字符串) 原字符串
	Public Function C10To2(Byval p_s)
		Dim t_t : t_t = ""
		Dim t_s : t_s = Sgn(p_s)
		Dim t_k : t_k = Abs(p_s)
		Dim t_d : t_d = 1
		Dim t_i : t_i=0
		Dim t_p : t_p=0
		If t_p=1 Then
			Dim t_n : t_n=0
			If t_k >= 2 ^ 31 Then
				C10To2 = p_s
				Exit Function
			End If
			Do
				If (t_k And 2 ^ t_n) = 2 ^ t_n Then
					t_t = "1" & t_t
				Else
					t_t = "0" & t_t
				End If
				t_n = t_n + 1
			Loop Until 2 ^ t_n > t_k
		Else
			Do
				If t_k < 2^t_d Then
					Exit Do
				Else
					t_d = t_d + 1
				End If
			Loop
			For t_i=t_d To 1 Step-1
				IF t_k >= 2^(i-1) Then
					t_k = t_k - 2^(i-1)
					t_t = t_t & "1"
				Else
					t_t = t_t & "0"
				End If
			Next
		End If
		IF t_s = -1 Then
			t_t = "-" & t_t
		End If
		C10To2 = t_t
	End Function
	
	'''16进制转为2进制
	'p_s:String (字符串) 原字符串
	Public Function C16To2(Byval p_s)
		Dim t_t : t_t = ""
		Dim t_o
		Dim t_i : t_i=0
		For t_i=1 To Len(trim(p_s))
			t_o= C10To2(Cint(Int("&h" & Mid(p_s,t_i,1))))
			Do while Len(t_o)<4
				t_o = "0" & t_o
			Loop
			t_t = t_t & t_o
		Next
		C16To2 = t_t
	End Function

	'''
	Private Function convChinese_(Byval p_s)
		Dim t_a : t_a = Split(Mid(p_s,2),"%")
		Dim t_i,t_j
		t_i = 0
		t_j = 0
		For t_i=0 To Ubound(t_a)
			t_a(t_i) = C16To2(t_a(t_i))
		Next
		Dim t_s,t_d,t_t
		For t_i=0 To Ubound(t_a)-1
			t_d = Instr(t_a(t_i),"0")
			t_s = ""
			For t_j=1 To t_d-1
				IF t_j=1 Then
					t_a(t_i) = Right(t_a(t_i),Len(t_a(t_i))-t_d)
					t_s = t_s & t_a(t_i)
				Else
					t_i = t_i + 1
					t_a(t_i) = Right(t_a(t_i),Len(t_a(t_i))-2)
					t_s = t_s & t_a(t_i)
				End If
			Next
			If Len(C2To16(t_s))=4 Then
				t_t = t_t & ChrW(int("&H" & C2To16(t_s)))
			Else
				t_t = t_t & Chr(int("&H" & C2To16(t_s)))
			End If
		Next
		convChinese_ = t_t
	End Function

	'''utf-8转gb2312
	'p_s:String (字符串) 原字符串
	Public Function UTF2GB(Byval p_s)
		Dim t_s : t_s = p_s
		Dim t_i, t_t : t_t = ""
		IF IsNull(t_s) Or t_s="" Then
			UTF2GB="" : Exit Function
		End If
		t_s = Replace(t_s, "+", "%20")
		For t_i=1 To Len(t_s)
			IF Mid(t_s,t_i,1) = "%" Then
				IF LCase(Mid(t_s,t_i+1,1))="e" Then
					t_t = t_t & convChinese_(Mid(t_s,t_i,9))
					t_i = t_i + 8
				Else
					t_t = t_t & Chr(Eval("&h"+Mid(t_s,t_i+1,2)))
					t_i = t_i + 2
				End If
			Else
				t_t = t_t & Mid(t_s,t_i,1)
			End If
		Next
		UTF2GB = t_t
	End Function

	'''UTF2GB的别名
	Public Function UTG(Byval p_s)
		UTG = UTF2GB(p_s)
	End Function

	'''把普通字符串 转成 二进制字符串(不支持中文)(注意：二进制字符串 与 普通字符串 是有区别的,使用Response.BinaryWrite)
	'p_s: String (字符串) 原字符串
	Public Function Str2Bin(Byval p_s)
		Dim t_t : t_t = ""
		Dim t_i, t_c, t_a, t_l, t_h
		For t_i=1 To Len(p_s)
			t_c = Mid(p_s,t_i,1)
			t_a = Asc(t_c)
			If t_a<0 Then
				t_a = t_a + 65535
			End If
			If t_a>255 Then
				t_l = Left(Hex(Asc(t_c)),2)
				t_h = Right(Hex(Asc(t_c)),2)
				t_t = t_t & ChrB("&H" & t_l) & ChrB("&H" & t_h)
			Else
				t_t = t_t & ChrB(Asc(t_c))
			End If
		Next
		Str2Bin = t_t
	End Function

	'''把普通字符串 转成 二进制字符串(支持全部字符)
	Public Function STB(Byval p_s)
		With s_stm
			.Type = 2
			.CharSet = "utf-8"
			.Open
			.WriteText(p_s)
			.Position = 0
			.Type = 1
			STB = .Read
			.Close
		End With
    End Function

	'''把二进制字符串 转成 普通字符串(不支持中文)
	'p_s: Bin String (二进制) 二进制字符串
	Public Function Bin2Str(Byval p_s)
		Dim t_i, t_s, t_l
		For t_i=1 To LenB(p_s)
			t_l = MidB(p_s,t_i,1)
			If AscB(t_l)<128 Then
				t_s = t_s & Chr(AscB(t_l))
			Else
				t_i = t_i + 1
				If t_i <= LenB(p_s) Then
					t_s = t_s & Chr(AscW(MidB(p_s,t_i,1)&t_l))
				End If
			End If
		Next
		Bin2Str = t_s
	End Function

	'''使用adodb.stream将把二进制字符串 转成 普通字符串
	'p_s: Bin String (二进制) 二进制字符串
	Public Function BTS(Byval p_s)
		With s_stm
			.Mode = 3
			.Type = 1
			.Open
			.Write(p_s)
			.Position = 0
			.Type = 2
			.CharSet = "utf-8"
			BTS = .ReadText
			.Close
		End With
    End Function

	'''向左移位(移位运算),返  回2进制值形式的字符串
	'p_t: Integer (十进制整数) 原数值
	'p_b: Integer (十进制整数) 向左移位移动的位数
	Public Function LShift(Byval p_t, Byval p_b)
		On Error Resume Next
		If Not s_init Then
			init_()
		End If
		If (p_b <= 0) Then
			LShift = p_t
		ElseIf (p_b > 63) Then
			' .. error ...
		ElseIf (p_b > 31) Then
			LShift = 0
		Else
			If (p_t And s_lPower2(31 - p_b)) = s_lPower2(31 - p_b) Then
				LShift = (p_t And (s_lPower2(31 - p_b) - 1)) * s_lPower2(p_b) Or s_lPower2(31)
			Else
				LShift = (p_t And (s_lPower2(31 - p_b) - 1)) * s_lPower2(p_b)
			End If
		End If
		On Error Goto 0
	End Function

	'''LShift的别名
	Public Function LS(Byval p_t, Byval p_b)
		LS = LShift(p_t, p_b)
	End Function
	
	'''向右移位(移位运算),返  回2进制值形式的字符串
	'p_t: Integer (整数) 原数值
	'p_b: Integer (整数) 向右移位移动的位数
	Public Function RShift(Byval p_t, Byval p_b)
		On Error Resume Next
		If Not s_init Then
			init_()
		End If
		If (p_b <= 0) Then
			RShift = p_t
		ElseIf (p_b > 63) Then
			' ... error ...
		ElseIf (p_b > 31) Then
			RShift = 0
		Else
			If (p_t And s_lPower2(31)) = s_lPower2(31) Then
				RShift = (p_t And &H7FFFFFFF) \ s_lPower2(p_b) Or s_lPower2(31 - p_b)
			Else
				RShift = p_t \ s_lPower2(p_b)
			End If
		End If
		On Error Goto 0
	End Function

	'''RShift的别名
	Public Function RS(Byval p_t, Byval p_b)
		RS = RShift(p_t, p_b)
	End Function
End Class
%>